Sitio: Tlacotepec

Se tiene un marco de datos que contiene varias métricas relacionadas, y se calculó (con la teoría de la información): entropía, información mutua, ganancia de información y relación de ganancia.

Para esto se contó con los datos multivariados (marco de datos de entrada), y todas las variables se evaluaron contra una variable definida (como parámetro “objetivo”).

Acontinuación se presentan cuatro apartados de gráficos del cuerpo de agua Río Metztitlán, sitio sitio.

Los gráficos son en el siguiente orden:

Matriz de Información Mutua
Análisis de correlación basado en la Teoría de la Información
- Información mutua
- Entropía
- Ganancia de información
- Proporción de Ganancia (de información)
Todos los cálculos fueron hechos en el entorno y lenguaje de programación R con la biblioteca FunModeling

Matríz de Información Mutua

sitio_mim <- read.csv("data/tlacotepec_mim.csv")

sitio_mim[is.na(sitio_mim)] <- 0

#calculo de MIC
#res_mine=mine(sitio_mim)

library(infotheo)

#sitio_mim <- read.csv("data/tlacotepec_mim.csv")
# Discretizar cada variable
matriz=discretize(sitio_mim) 

# Calcular la "correlación" basándonos en información mutua
matriz_im=mutinformation(matriz, method= "emp")

# Truco para visualizar el valor máximo de la escala
# excluyendo la diagonal (variable con respecto a sí misma)
diag(matriz_im)=0

# Gráfico de correlación con color y correlación con información mutua del paquete Infotheo. 
corrplot(matriz_im, method="color",type="lower", number.cex=0.6,addCoef.col = "black", tl.col="red", tl.srt=90, tl.cex = 0.9, diag=FALSE, is.corr = F)

eti_sitio = c(
  'SAAM', 
  'OD_mg.L', 
  'COLI_TOT', 
  'pH_CAMPO', 
  'TEMP_AGUA', 
  'NI_TOT',
  'E_COLI', 
  'HG_TOT', 
  'CR_TOT', 
  'AS_TOT', 
  'TURBIEDAD', 
  'SST', 
  'COLOR_VER',
  'DUR_TOT', 
  'N_TOT', 
  'COLI_FEC', 
  'N_NH3', 
  'N_NO2', 
  'N_NO3')


names_eti_sitio = c(
  'Sustancias Activas al Azul de Metileno',
 'Oxígeno Disuelto',
 'Coliformes Totales',
 'Potencial de Hidrógeno',
 'Temperatura agua',
 'Níquel Total',
 'Escherichia coli',
 'Mercurio Total',
 'Cromo Total',
 'Arsénico Total',
 'Turbiedad',
 'Sólidos Suspendidos Totales',
 'Color Verdadero',
 'Dureza Total',
 'Nitrógeno Total (Cálculo)',
 'Coliformes Fecales',
 'Nitrógeno Amoniacal',
 'Nitrógeno de Nitritos',
 'Nitrógeno de Nitratos')

Gráficas Información Mutua

for (i in seq_along(eti_sitio)) {
  
    print(myplot <- ggplot(var_rank_info(sitio_mim,  eti_sitio[i]), aes(x = reorder(var, mi),y = mi, fill = var))
          + geom_bar(stat = "identity") 
          + coord_flip() 
          + theme_bw() 
          + xlab("")
          + ylab("Información Mutua")
          + ggtitle(names_eti_sitio[i])
          + theme(plot.title = element_text(hjust = 0.5))
          + guides(fill = FALSE))
  
  #print(var_rank_info(sitio_normal, eti_sitio[i]))
  #save table in csv
  #name_mi <- names_eti_sitio[i]
  #name_table_mi <- paste("csv-graphs/tlaco/mi/",name_mi,"_mi.csv",sep = "")
  #write.table(var_rank_info(sitio_mim, eti_sitio[i]), file = name_table_mi, sep = ",", col.names = NA)
  
  #save plot
  #plot_mi <- paste("images/tlaco/mi/",name_mi,"_mi.png",sep = "")
  #ggsave(plot_mi)
}

Gráficas Entropía

for (j in seq_along(eti_sitio)) {
  
    print(myplot <- ggplot(var_rank_info(sitio_mim,  eti_sitio[j]), aes(x = reorder(var, en),y = en, fill = var))
          + geom_bar(stat = "identity") 
          + coord_flip() 
          + theme_bw() 
          + xlab("") 
          + ylab("Entropía")
          + ggtitle(names_eti_sitio[j])
          + theme(plot.title = element_text(hjust = 0.5))
          + guides(fill = FALSE))
  
  #print(var_rank_info(sitio_normal, eti_sitio[j]))
  #save table in csv
  #name_en <- names_eti_sitio[j]
  #name_table_en <- paste("csv-graphs/tlaco/en/",name_en,"_en.csv",sep = "")
  #write.table(var_rank_info(sitio_mim, eti_sitio[j]), file = name_table_en, sep = ",", col.names = NA)
  
  #save plot
  #plot_en <- paste("images/tlaco/en/",name_en,"_en.png",sep = "")
  #ggsave(plot_en)
}

Gráficas Ganancia de información

for (k in seq_along(eti_sitio)) {
  
    print(myplot <- ggplot(var_rank_info(sitio_mim,  eti_sitio[k]), aes(x = reorder(var, ig),y = ig, fill = var))
          + geom_bar(stat = "identity") 
          + coord_flip() 
          + theme_bw() 
          + xlab("") 
          + ylab("Ganancia de la Información")
          + ggtitle(names_eti_sitio[k])
          + theme(plot.title = element_text(hjust = 0.5))
          + guides(fill = FALSE))
  
  #print(var_rank_info(sitio_normal, eti_sitio[k]))
  #save table in csv
  #name_ig <- names_eti_sitio[k]
  #name_table_ig <- paste("csv-graphs/tlaco/ig/",name_ig,"_ig.csv",sep = "")
  #write.table(var_rank_info(sitio_mim, eti_sitio[k]), file = name_table_ig, sep = ",", col.names = NA)
  
  #save plot
  #plot_ig <- paste("images/tlaco/ig/",name_ig,"_ig.png",sep = "")
  #ggsave(plot_ig)
}

Gráficas Proporción de Ganancia (de información)

for (l in seq_along(eti_sitio)) {
  
    print(myplot <- ggplot(var_rank_info(sitio_mim,  eti_sitio[l]), aes(x = reorder(var, gr),y = gr, fill = var))
          + geom_bar(stat = "identity") 
          + coord_flip() 
          + theme_bw() 
          + xlab("") 
          + ylab("Proporción de Ganancia (de información)")
          + ggtitle(names_eti_sitio[l])
          + theme(plot.title = element_text(hjust = 0.5))
          + guides(fill = FALSE))
  
  #print(var_rank_info(sitio_normal, eti_sitio[l]))
  #save table in csv
  #name_gr <- names_eti_sitio[l]
  #name_table_gr <- paste("csv-graphs/tlaco/gr/",name_gr,"_gr.csv",sep = "")
  #write.table(var_rank_info(sitio_mim, eti_sitio[l]), file = name_table_gr, sep = ",", col.names = NA)
  
  #save plot
  #plot_gr <- paste("images/tlaco/gr/",name_gr,"_gr.png",sep = "")
  #ggsave(plot_gr)
}